home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / COM / MacWebLint 1.014 folder.sit / MacWebLint 1.014 folder / MacWebLint-1.014 / MacWebLint-Lib.pl < prev    next >
Text File  |  1996-02-25  |  12KB  |  439 lines
  1. #========================================================================
  2. # Function:    CheckAttributes
  3. # Purpose:    If the tag has attributes, check them for validity.
  4. #========================================================================
  5. sub CheckAttributes
  6. {
  7.    undef %args;
  8.  
  9.    if ($closing == 0 && $tag =~ m|^(¥S+)¥s+(.*)|)
  10.    {
  11.       ($id,$tail) = ($1,$2);
  12.       $ID = "¥U$id";
  13.       $tail =~ s/¥n/ /g;
  14.  
  15.       # check for odd number of quote characters
  16.       ($quotes = $tail) =~ s/[^"]//g;
  17.       &whine($., 'odd-quotes', $tag) if length($quotes) % 2 == 1;
  18.  
  19.       $novalue = 0;
  20.       $valid = $validAttributes{$ID};
  21.       while ($tail =~ /^¥s*([^=¥s]+)¥s*=¥s*(.*)$/
  22.          # catch attributes like ISMAP for IMG, with no arg
  23.          || ($tail =~ /^¥s*(¥S+)(.*)/ && ($novalue = 1)))
  24.       {
  25.      $arg = "¥U$1";
  26.      $rest = $2;
  27.  
  28.      &whine($., 'unexpected-open', $tag) if $arg =~ /</;
  29.  
  30.      if ($arg !~ /^($valid)$/i && $ID =~ /^($legalElements)$/o)
  31.      {
  32.         if ($arg =~ /^($netscapeAttributes{$ID})$/i)
  33.         {
  34.            &whine($., 'netscape-attribute', $arg, $id);
  35.         }
  36.         else
  37.         {
  38.            &whine($., 'unknown-attribute', $id, $arg);
  39.         }
  40.      }
  41.  
  42.      #-- catch repeated attributes.  for example:
  43.      #--     <IMG SRC="foo.gif" SRC="bar.gif">
  44.      if (defined $args{$arg})
  45.      {
  46.         &whine($., 'repeated-attribute', $arg, $id);
  47.      }
  48.  
  49.      if ($novalue)
  50.      {
  51.         $args{$arg} = '';
  52.         $tail = $rest;
  53.      }
  54.      elsif ($rest =~ /^'([^']+)'(.*)$/)
  55.          {
  56.         &whine($., 'attribute-delimiter', $arg, $ID);
  57.             $args{$arg} = $1;
  58.             $tail = $2;
  59.          }
  60.      elsif ($rest =~ /^"([^"]+)"(.*)$/
  61.         || $rest =~ /^'([^']+)'(.*)$/
  62.         || $rest =~ /^(¥S+)(.*)$/)
  63.          {
  64.             $args{$arg} = $1;
  65.             $tail = $2;
  66.          }
  67.          else
  68.          {
  69.         $args{$arg} = $rest;
  70.         $tail = '';
  71.          }
  72.      $novalue = 0;
  73.       }
  74.       foreach $attr (keys %args)
  75.       {
  76.          if (defined $attributeFormat{$attr} &&
  77.              $args{$attr} !~ /^($attributeFormat{$attr})$/i)
  78.          {
  79.             &whine($., 'attribute-format', $attr, $id, $args{$attr});
  80.          }
  81.       }
  82.       &whine($., 'unexpected-open', $tag) if $tail =~ /</o;
  83.    }
  84.    else
  85.    {
  86.       if ($closing && $id =~ m|^(¥S+)¥s+(.*)|)
  87.       {
  88.      &whine($., 'closing-attribute', $tag);
  89.      $id = $1;
  90.       }
  91.       $ID = "¥U$id";
  92.    }
  93. }
  94.  
  95. #========================================================================
  96. # Function:    whine
  97. # Purpose:    Give a standard format whine:
  98. #            filename(line #): <message>
  99. #               The associative array `enabled' is used as a gating
  100. #               function, to suppress or enable each warning.  Every
  101. #               warning has an associated identifier, which is used to
  102. #               refer to the warning, and as the index into the hash.
  103. #========================================================================
  104. sub whine
  105. {
  106.    local($line, $id, @argv) = @_;
  107.    local($mstyle)        = $variable{'message-style'};
  108.  
  109. ## JS 2-4-96
  110. ## Added the following lines so that the results would be saved to a file
  111. ## this is nice for the mac version.
  112. ## The results file is saved in the same folder as MacWebLint
  113.    open (OUTFILE, ">>$gResults") || die "Cannot open gResults: $!¥n";
  114.  
  115.    return unless $enabled{$id};
  116.    $exit_status = 1;
  117.  
  118. ## JS 12-6-95
  119. ## rewritten to output to a text file cause this is the way that
  120. ## I want it to work. this is the best way that I know how to do it.
  121.  
  122.   if ($mstyle eq 'terse') {
  123.       print "$filename:$line:$id¥n";
  124.       print OUTFILE "$filename:$line:$id¥n";
  125.    return; }
  126.    
  127.   if ($mstyle eq 'lint') {
  128.       (eval "print ¥"$filename($line): $message{$id}¥n¥"");
  129.       (eval "print OUTFILE ¥"$filename($line): $message{$id}¥n¥"");
  130.   return; }
  131.  
  132.   if ($mstyle eq 'short') {
  133.       (eval "print ¥"line $line: $message{$id}¥n¥"");
  134.       (eval "print OUTFILE ¥"line $line: $message{$id}¥n¥"");
  135.    return; }
  136.       
  137.    close (OUTFILE);
  138.  
  139. # JS 12-6-95
  140. #  commented this out because it is re-done above
  141. #   (print "$filename:$line:$id¥n"), return             if $mstyle eq 'terse';
  142. #   (eval "print ¥"$filename($line): $message{$id}¥n¥""), return if $mstyle eq 'lint';
  143. #   (eval "print ¥"line $line: $message{$id}¥n¥""), return if $mstyle eq 'short';
  144.  
  145.    die "Unknown message style `$mstyle'¥n";
  146. }
  147.  
  148.  
  149. #========================================================================
  150. # Function:    GetConfigFile
  151. # Purpose:    Read user's configuration file, if such exists.
  152. #               If WEBLINTRC is set in user's environment, then read the
  153. #               file referenced, otherwise try for $HOME/.weblintrc.
  154. #========================================================================
  155. sub GetConfigFile
  156. {
  157.    local(*CONFIG);
  158.    local($filename);
  159.    local($arglist);
  160.    local($value);
  161.  
  162.  
  163. # JS 2-4-96
  164. # this is the config file for MacWebLint.
  165.       $filename = "MacWebLint.rc";
  166.       return unless -f $filename;
  167.  
  168.    open(CONFIG,"< $filename") || do
  169.    {
  170.       print WARNING "Unable to read config file `$filename': $!¥n";
  171.       return 0;
  172.    };
  173.  
  174.    while (<CONFIG>)
  175.    {
  176.       s/#.*$//;
  177.       next if /^¥s*$/o;
  178.  
  179.       #-- match keyword: process one or more argument -------------------
  180.       if (/^¥s*(enable|disable|extension|ignore)¥s+(.*)$/io)
  181.       {
  182.      $keyword = "¥U$1";
  183.      $arglist = $2;
  184.      while ($arglist =~ /^¥s*(¥S+)/o)
  185.      {
  186.         $value = "¥L$1";
  187.  
  188.         &enableWarning($1, 1) if $keyword eq 'ENABLE';
  189.  
  190.         &enableWarning($1, 0) if $keyword eq 'DISABLE';
  191.  
  192.         $ignore{"¥U$1"} = 1 if $keyword eq 'IGNORE';
  193.  
  194.         &AddExtension("¥L$1") if $keyword eq 'EXTENSION';
  195.  
  196.         $arglist = $';
  197.      }
  198.       }
  199.       elsif (/^¥s*set¥s+(¥S+)¥s*=¥s*(.*)/)
  200.       {
  201.          # setting a weblint variable
  202.          if (defined $variable{$1})
  203.          {
  204.             $variable{$1} = $2;
  205.          }
  206.          else
  207.          {
  208.             print WARNING "Unknown variable `$1' in configuration file¥n";
  209.          }
  210.       }
  211.    }
  212.  
  213.    close CONFIG;
  214.  
  215.    1;
  216. }
  217.  
  218. sub enableWarning
  219. {
  220.    local($id, $enabled) = @_;
  221.  
  222.  
  223.    if (! defined $enabled{$id})
  224.    {
  225.       print WARNING "$PROGRAM: unknown warning identifier ¥"$id¥"¥n";
  226.       return 0;
  227.    }
  228.  
  229.    $enabled{$id} = $enabled;
  230.  
  231.    #
  232.    # ensure consistency: if you just enabled upper-case,
  233.    # then we should make sure that lower-case is disabled
  234.    #
  235.    $enabled{'lower-case'} = 0 if $_ eq 'upper-case';
  236.    $enabled{'upper-case'} = 0 if $_ eq 'lower-case';
  237.    $enabled{'upper-case'} = $enabled{'lower-case'} = 0 if $_ eq 'mixed-case';
  238.  
  239.    return 1;
  240. }
  241.  
  242. #========================================================================
  243. # Function:    AddExtension
  244. # Purpose:    Extend the HTML understood.  Currently supported extensions:
  245. #            netscape  - the netscape extensions proposed by
  246. #                                   Netscape Communications, Inc.  See:
  247. #               http://www.netscape.com/home/services_docs/html-extensions.html
  248. #========================================================================
  249. sub AddExtension
  250. {
  251.    local($extension) = @_;
  252.    local(@extlist);
  253.    local($element);
  254.  
  255.    if ($extension =~ /,/)
  256.    {
  257.       @extlist = split(/¥s*,¥s*/, $extension);
  258.       &AddExtension(shift @extlist) while @extlist > 0;
  259.       return;
  260.    }
  261.  
  262.    if ($extension ne 'netscape' && $extension ne 'java')
  263.    {
  264.       warn "$PROGRAM: unknown extension `$extension' -- ignoring.¥n";
  265.       return;
  266.    }
  267.  
  268.    #---------------------------------------------------------------------
  269.    # java extensions
  270.    #---------------------------------------------------------------------
  271.  
  272.    if ($extension eq 'java')
  273.    {
  274.       $legalElements .= '|'.$javaElements;
  275.       $pairElements  .= '|APPLET';
  276.  
  277.       &AddAttributes('APPLET', 'CODEBASE', 'CODE', 'ALT', 'NAME',
  278.                    'WIDTH', 'HEIGHT', 'ALIGN', 'VSPACE', 'HSPACE');
  279.       &AddAttributes('PARAM', 'NAME', 'VALUE');
  280.  
  281.       $requiredContext{'PARAM'} = 'APPLET';
  282.       $requiredAttributes{'APPLET'} = 'CODE|WIDTH|HEIGHT';
  283.       $requiredAttributes{'PARAM'} = 'NAME|VALUE';
  284.  
  285.       return;
  286.    }
  287.  
  288.    #---------------------------------------------------------------------
  289.    # netscape extensions
  290.    #---------------------------------------------------------------------
  291.  
  292.    #-- new element attributes for existing elements ---------------------
  293.    foreach $element (keys %netscapeAttributes)
  294.    {
  295.       &AddAttributes($element, split(/¥|/, $netscapeAttributes{$element}));
  296.    }
  297.  
  298.    #-- formats for new attributes ---------------------------------------
  299.  
  300.    $attributeFormat{'SIZE'} = '[-+]?¥d+';
  301.    $attributeFormat{'MARGINWIDTH'} = '¥d+';
  302.    $attributeFormat{'MARGINHEIGHT'} = '¥d+';
  303.    $attributeFormat{'SCROLLING'} = 'NO|YES|AUTO';
  304.    $attributeFormat{'WIDTH'} = '¥d+%?';
  305.  
  306.    #-- new elements -----------------------------------------------------
  307.  
  308.    $legalElements .= '|'.$netscapeElements;
  309.    $pairElements  .= '|BLINK|CENTER|FONT|FRAMESET|NOFRAMES|NOBR|MAP|SCRIPT';
  310.    $requiredContext{'AREA'}  = 'MAP';
  311.    $requiredContext{'FRAME'} = 'FRAMESET';
  312.    $requiredAttributes{'MAP'}   = 'NAME';
  313.    $requiredAttributes{'AREA'}  = 'COORDS';
  314.  
  315.    $okInHead{'SCRIPT'} = 1;
  316. }
  317.  
  318. sub AddAttributes
  319. {
  320.    local($element,@attributes) = @_;
  321.    local($attr);
  322.  
  323.  
  324.    $attr = join('|', @attributes);
  325.    if (defined $validAttributes{$element})
  326.    {
  327.       $validAttributes{$element} .= "|$attr";
  328.    }
  329.    else
  330.    {
  331.       $validAttributes{$element} = "$attr";
  332.    }
  333. }
  334.  
  335. #========================================================================
  336. # Function:    ListWarnings()
  337. # Purpose:    List all supported warnings, with identifier, and
  338. #        whether the warning is enabled.
  339. #========================================================================
  340. sub ListWarnings
  341. {
  342.    local($id);
  343.    local($message);
  344.  
  345.  
  346.    foreach $id (sort keys %enabled)
  347.    {
  348.       ($message = $message{$id}) =~ s/¥$argv¥[¥d+¥]/.../g;
  349.       $message =~ s/¥¥"/"/g;
  350.       print WARNING "$id (", ($enabled{$id} ? "enabled" : "disabled"), ")¥n";
  351.       print WARNING "    $message¥n¥n";
  352.    }
  353. }
  354.  
  355. sub CheckURL
  356. {
  357.    local($url)        = @_;
  358.    local($workfile)    = "$TMPDIR/$PROGRAM.$$";
  359.    local($urlget)    = $variable{'url-get'};
  360.  
  361.  
  362.    die "$PRORGAM: url-get variable is not defined -- ".
  363.        "don't know how to get $url¥n" unless defined $urlget;
  364.  
  365.    system("$urlget $url > $workfile");
  366.    &WebLint($workfile, $url);
  367.    unlink $workfile;
  368. }
  369.  
  370. sub PrintToDo
  371. {
  372.    die "$todo" unless defined $variable{'url-get'};
  373.    print "[grabbing weblint todo list - $ToDoURL]¥n";
  374.    system("$variable{'url-get'} $ToDoURL");
  375. }
  376.  
  377. #========================================================================
  378. # Function:    wanted
  379. # Purpose:    This is called by &find() to determine whether a file
  380. #               is wanted.  We're looking for files, with the filename
  381. #               extension .html or .htm.
  382. #========================================================================
  383. # JS - 2-4-96
  384. # I completely re-wrote this function so that it would work correctly
  385. # the way that I wanted it to work. I guess it changed between the 1.011
  386. # and this version to support more than one index.html filename. Unfortunately, 
  387. # it did not seem to work correctly on the Mac. While my version may not 
  388. # be the fastest, it seems to work, which is more important to me. :)
  389.  
  390. sub wanted
  391. {
  392.    local($foundIndex);
  393.  
  394.     if ( -d $name )
  395.     {
  396.         $foundIndex = 0;
  397.         foreach $legalIndex (@dirIndices)
  398.         {
  399.             if ( -f ("$name" . ":" . "$legalIndex") )
  400.             {
  401.                 $foundIndex=1;
  402.                 last;
  403.             }
  404.         }    
  405.         if (! $foundIndex)
  406.         {
  407.             &whine("$name", 'directory-index', "@dirIndices");
  408.         }
  409.     }
  410.  
  411.        /¥.(html|htm)$/ &&        # valid filename extensions: .html .htm
  412.       -f $_ &&            # only looking for files
  413.       (!$opt_l || !-l $_) &&    # ignore symlinks if -l given
  414.       &WebLint($_,$name);    # check the file
  415. }
  416.  
  417. sub PopEndTag
  418. {
  419.    $matched     = pop @tags;
  420.    pop @tagNums;
  421.    $matchedLine = pop @taglines;
  422.  
  423.    #-- does top of stack match top of orphans stack? --------
  424.    while (@orphans > 0 && @tags > 0
  425.       && $orphans[$#orphans] eq $tags[$#tags])
  426.    {
  427.       &whine($., 'element-overlap', $orphans[$#orphans],
  428.          $orphanlines[$#orphanlines], $matched, $matchedLine);
  429.       pop @orphans;
  430.       pop @orphanlines;
  431.       pop @tags;
  432.       pop @tagNums;
  433.       pop @taglines;
  434.    }
  435.    $tagRE = join('|',@tags);
  436. }
  437.  
  438. 1;
  439.